home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / test / exercise.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  27.2 KB  |  776 lines  |  [TEXT/ttxt]
  1. ; -*- mode:     CL -*- ----------------------------------------------------- ;
  2. ; File:         exercise.lisp
  3. ; Description:  
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:      26-Mar-92
  6. ; Modified:     Tue Aug  2 17:43:02 1994 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      CL-USER
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1992, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. (in-package "CL-USER")
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;                                  pathnames
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (defvar *ZEBU-directory*
  24.   (make-pathname :directory (butlast (pathname-directory *load-pathname*)))
  25.   )
  26.  
  27. (defvar *ZEBU-binary-directory*
  28.   (make-pathname :directory (append (pathname-directory *ZEBU-directory*)
  29.                     (list "binary"))))
  30.  
  31. (defvar *ZEBU-test-directory*
  32.   (make-pathname :directory (append (pathname-directory *ZEBU-directory*)
  33.                     (list "test"))))
  34.  
  35. (defvar *ZEBU-test-binary-directory*
  36.   (make-pathname :directory (append (pathname-directory *ZEBU-test-directory*)
  37.                     (list "binary"))))
  38.  
  39. #+DEFSYS
  40. (let ((*default-pathname-defaults* *ZEBU-directory*))
  41.   (require "ZEBU-sys")
  42.   (ds:compile-system 'Zebu-compiler)
  43.   (ds:load-system 'Zebu-compiler)
  44.   (ds:load-system 'Zebu-rr)
  45.   (use-package (find-package "ZEBU")
  46.                (find-package "CL-USER"))
  47. )
  48.  
  49. #-DEFSYS
  50. (let ((*default-pathname-defaults* *ZEBU-directory*))
  51.   (load "ZEBU-init"))
  52. #-DEFSYS
  53. (zb::zebu-compiler)
  54.  
  55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56. ;;                                     ex1
  57. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  58.  
  59. #+DEFSYS
  60. (progn (ds:compile-module "ex1") (ds:load-module "ex1"))
  61. #-DEFSYS
  62. (progn
  63.   (zebu-compile-file (merge-pathnames
  64.                       (make-pathname :name "ex1" :type "zb") *ZEBU-test-directory*)
  65.                      :output-file
  66.                      (merge-pathnames
  67.                       (make-pathname :name "ex1" :type "tab")
  68.                       *ZEBU-test-binary-directory*))
  69.   
  70.   (zb:zebu-load-file (merge-pathnames
  71.                       (make-pathname :name "ex1" :type "tab")
  72.                       *ZEBU-test-binary-directory*)))
  73. (setq zebu:*current-grammar* (find-grammar "ex1"))
  74. (format t "Grammar: ~S" zebu:*current-grammar*)
  75.  
  76. (let ((l '(1 "+" a foo bar)))
  77.   (multiple-value-bind (v rest)
  78.       (list-parser l :junk-allowed t)
  79.     (unless (and (equal v '(+OP (EXPRESSION (TERM (FACTOR 1)))
  80.                 (TERM (FACTOR A))))
  81.          (eq rest (nthcdr 3 l)))
  82.       (warn "list-parser broken"))))
  83.  
  84. (handler-case (list-parser '(1  "+" a ) )
  85.           (error () 'ok)
  86.           (:no-error (&rest args) (format nil "~%error ~s" args)))
  87.  
  88. (if (and 
  89.      (equal (read-parser "1 + a")
  90.         '(+OP (EXPRESSION (TERM (FACTOR 1)))
  91.           (TERM (FACTOR A))))
  92.      (equal (read-parser "1 + a") (read-parser "1 + a  dd" :junk-allowed t))
  93.      (equal (list-parser '(1 "+" a foo bar)  :junk-allowed t)
  94.         (read-parser "1 + a  foo bar" :junk-allowed t))
  95.      (equal (read-parser ".1 + 1/3") (read-parser "0.1 + 1/3"))
  96.      (equal (read-parser "1 + a") (list-parser '(1 "+" a)))
  97.      (equal (read-parser "1 + 1") (list-parser '(1 "+" 1)))
  98.      (equal (read-parser "1 + x * y") (list-parser '(1 "+" x "*" y)))
  99.      (equal (read-parser "(1 + x) * y") (list-parser '("(" 1 "+" x ")" "*" y))))
  100.     (print 'ok)
  101.   (warn "error parsing with grammar ex1")) 
  102.  
  103. (zb:FILE-PARSER (merge-pathnames "sample-ex1" *ZEBU-test-directory*) 
  104.                 :grammar (zb:find-grammar "ex1"))
  105.  
  106. (zebu::cruise-follow-sets)
  107. (zebu::print-productions)
  108.  
  109. (compile-slr-grammar
  110.  (merge-pathnames "ex1a.zb" *ZEBU-test-directory*)
  111.  :output-file (merge-pathnames "ex1a.tab" *ZEBU-test-binary-directory*))
  112. (zb:zebu-load-file (merge-pathnames "ex1a.tab" *ZEBU-test-binary-directory*))
  113.  
  114. (unless (zb:read-parser "" :grammar (find-grammar "ex1a"))
  115.   (warn "error with grammar ex1a, given an empty string"))
  116.  
  117. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  118. ;;                              meta-grammar test
  119. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  120. (unless (equal (zb::grammar-identifier-start-chars (zb:find-grammar "zebu-mg"))
  121.            "$-_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
  122.   (warn "zebu-mg"))
  123.  
  124. (zb:read-parser "Program := KB-domain: [(-stmts KB-Sequence)];"
  125.         :grammar (zb:find-grammar "zebu-mg"))
  126.  
  127. (zb:read-parser "Program := [(-stmts KB-Sequence)];"
  128.         :grammar (zb:find-grammar "zebu-mg"))
  129.  
  130. (zb:read-parser "Arith-exp := Kb-domain : [];"
  131.         :grammar (zb:find-grammar "zebu-mg"))
  132.  
  133. (zb:read-parser "Factor    := Arith-exp : [(-value)];"
  134.         :grammar (zb:find-grammar "zebu-mg"))
  135.  
  136. (zb:read-parser "Program --> \"begin\" Stmts \"end\"
  137.                  { Program: [(-stmts Stmts)
  138.                              (-label \"bar\")] } ;"
  139.         :grammar (zb:find-grammar "zebu-mg"))
  140.  
  141. (unless (equalp
  142.      (zb:read-parser "Program --> \"begin\" Stmts \"end\"
  143.                           { Program: [(-stmts Stmts)] } ;"
  144.              :grammar (zb:find-grammar "zebu-mg"))
  145.      #S(ZEBU::ZB-RULE
  146.         -NAME PROGRAM
  147.         -PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS
  148.                  -SYNTAX ("begin" STMTS "end")
  149.                  -SEMANTICS #S(ZEBU::FEAT-TERM
  150.                        -TYPE PROGRAM
  151.                        -SLOTS (#S(ZEBU::LABEL-VALUE-PAIR
  152.                               -LABEL -STMTS
  153.                               -VALUE STMTS)))
  154.                  -BUILD-FN NIL))))
  155.   (warn "zebu-mg 1"))
  156.  
  157. (with-open-file (s (merge-pathnames "arith-exp.zb" *ZEBU-test-directory*))
  158.   (read s)
  159.   (zb::file-parser-aux s #'error t (zb:find-grammar "zebu-mg") t))
  160.  
  161. (with-open-file (s (merge-pathnames "arith-exp.zb" *ZEBU-test-directory*))
  162.   (read s)
  163.   (zb::file-parser-aux s #'error t (zb:find-grammar "zebu-mg") t))
  164.  
  165.  
  166. #+DEFSYS (ds:compile-module "arith-exp")
  167. #-DEFSYS 
  168. (zebu-compile-file (merge-pathnames "arith-exp" *ZEBU-test-directory*)
  169.                    :output-file (merge-pathnames
  170.                                  "arith-exp" *ZEBU-test-binary-directory*))
  171.  
  172. (compile-file (merge-pathnames "arith-exp-domain.lisp" *ZEBU-test-directory*)
  173.               :output-file (merge-pathnames
  174.                             "arith-exp-domain" *ZEBU-test-binary-directory*))
  175.  
  176. (defun PRINT-FACTOR (item STREAM LEVEL)
  177.   (FORMAT STREAM "~a" (factor--value item)))
  178. #+DEFSYS 
  179. (ds:load-module "arith-exp")
  180. #-DEFSYS
  181. (zebu-load-file (merge-pathnames (make-pathname :name "arith-exp" :type "tab")
  182.                                  *ZEBU-test-binary-directory*))
  183. (zebu::print-actions "arith-exp")
  184.  
  185. (unless (and (equalp (list-parser '(ned "+" jed)
  186.                   :grammar (zb:find-grammar "arith-exp"))
  187.              (read-parser "ned + jed"
  188.                   :grammar (zb:find-grammar "arith-exp")))
  189.  
  190.          (equalp (read-parser "(ned + jed) * 4"
  191.                   :grammar (zb:find-grammar "arith-exp"))
  192.              '#S(Mult-OP
  193.              -ARG1 #S(FACTOR
  194.                   -VALUE #S(Plus-OP -ARG1 #S(FACTOR -VALUE NED)
  195.                             -ARG2 #S(FACTOR -VALUE JED)))
  196.              -ARG2 #S(FACTOR -VALUE 4))))
  197.   (warn "arith-exp did not compile correctly"))
  198.  
  199. (defun print-factor (item stream level)
  200.   (declare (ignore level))
  201.   (let ((v (factor--value item)))
  202.     (if (or (symbolp v) (numberp v))
  203.     (format stream "~a" v)
  204.       (format stream "(~a)" v))))
  205.  
  206. (unless (string= (with-output-to-string (s)
  207.            (prin1
  208.             (read-parser "(ned + jed) * 4"
  209.                  :grammar (zb:find-grammar "arith-exp"))
  210.             s))
  211.          "(NED + JED) * 4")
  212.   (warn "printing for arith-exp failed"))
  213.  
  214. ;; mini-la
  215. (let ((zebu:*allow-conflicts* t)
  216.       (*generate-domain* t)
  217.       (*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  218.   (compile-slr-grammar "mini-la.zb"
  219.    :output-file (merge-pathnames "mini-la.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  220.   )
  221. (setq zebu:*current-grammar*
  222.       (zebu-load-file (merge-pathnames "mini-la.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  223.  
  224. (unless (typep (zb::read-parser "begin a end" :grammar (zb:find-grammar "mini-la"))
  225.            'program)
  226.   (warn "failed to parse with mini-la: 1"))
  227.  
  228. (unless (typep (zb::read-parser "begin A; B ; C end"
  229.                 :grammar (zb:find-grammar "mini-la"))
  230.            'program)
  231.   (warn "failed to parse with mini-la: 2"))
  232.  
  233. (unless (typep (zb::read-parser "begin A; begin B1; B2 end ; C end"
  234.                 :grammar (zb:find-grammar "mini-la"))
  235.            'program)
  236.   (warn "failed to parse with mini-la: 3"))
  237.  
  238. (let ((s " begin F({1,2,4}) end"))
  239.   (equal (format nil "~s" (zb::read-parser s))
  240.      s)
  241.   )
  242.  
  243.  
  244. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  245. ;;                                    ex6_2
  246. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  247.  
  248. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  249.   (zebu-compile-file "ex6_2.zb"
  250.    :output-file (merge-pathnames "ex6_2.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  251.   (setq zebu:*current-grammar*
  252.       (zebu-load-file (merge-pathnames "ex6_2.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  253.   )
  254. (unless (and (let ((zb:*preserve-case* t))
  255.            (string= (format nil "~s" (read-parser "foo = 0"))
  256.             "foo = 0"))
  257.          (eq (type-of (read-parser "**foo = ***x")) 'ASSIGNMENT)
  258.          (equalp (ASSIGNMENT--lhs
  259.               (read-parser "**foo = ***x"))
  260.              (read-parser "**foo")))
  261.   (warn "Grammar ex6_2 did not compile correctly"))
  262.  
  263.  
  264. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  265. ;;                                     ex2
  266. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  267. #+DEFSYS
  268. (progn (compile-module "ex2") (load-module "ex2"))
  269.  
  270. #-DEFSYS
  271. (progn
  272.   (zebu-compile-file (merge-pathnames
  273.                       (make-pathname :name "ex2" :type "zb") *ZEBU-test-directory*)
  274.                      :output-file
  275.                      (merge-pathnames
  276.                       (make-pathname :name "ex2" :type "tab")
  277.                       *ZEBU-test-binary-directory*))
  278.   
  279.   (zb:zebu-load-file (merge-pathnames
  280.                       (make-pathname :name "ex2" :type "tab")
  281.                       *ZEBU-test-binary-directory*)))
  282.  
  283. (setq zebu:*current-grammar* (find-grammar "ex2"))
  284. (format t "Grammar: ~S" zebu:*current-grammar*)
  285.  
  286. (zebu::print-productions)
  287. (zebu::cruise-follow-sets)
  288. (zebu::print-actions (zebu::grammar-name zebu:*current-grammar*))
  289.  
  290. (and
  291.  (equal (read-parser "G") (list-parser '(G)))
  292.  (equal (read-parser "(G)") (list-parser '( "(" G ")" )))
  293.  (equal (read-parser "(((P)))") '((((P)))))
  294.  (equal (read-parser "(F + 3 + 1)") '((F "+" 3 "+" 1)))
  295.  (equal (read-parser "(F + 3 * (2 + 1))") '((F "+" 3 "*" (2 "+" 1))))
  296.  (equal (read-parser "(F + 3) * (2 + 1)") '((F "+" 3) "*" (2 "+" 1)))
  297.  (equal (read-parser "((F + 3) * 2) + 1") '(((F "+" 3) "*" 2) "+" 1))
  298.  (equal (list-parser '(ned "+" "(" jed "*" fred ")"))
  299.     '(NED "+" (JED "*" FRED)))
  300.  (print 1))
  301.  
  302. (and 
  303.  (let (zebu:*current-grammar*)
  304.    (equal (read-parser "ned + jed"     :grammar (find-grammar "ex2"))
  305.       (list-parser '(ned "+" jed ) :grammar (find-grammar "ex2"))))
  306.  
  307.  (equal (read-parser "ned + jed"     :grammar (find-grammar "ex2"))
  308.     (list-parser '(ned "+" jed ) :grammar (find-grammar "ex2")))
  309.  (print 2))
  310.  
  311. #+DEFSYS
  312. (progn (compile-module "ex3") (load-module "ex3"))
  313. #-DEFSYS
  314. (progn
  315.   (zebu-compile-file (merge-pathnames
  316.                       (make-pathname :name "ex3" :type "zb") *ZEBU-test-directory*)
  317.                      :output-file
  318.                      (merge-pathnames
  319.                       (make-pathname :name "ex3" :type "tab")
  320.                       *ZEBU-test-binary-directory*))
  321.   
  322.   (zb:zebu-load-file (merge-pathnames
  323.                       (make-pathname :name "ex3" :type "tab")
  324.                       *ZEBU-test-binary-directory*)))
  325.  
  326. (and 
  327.  (equal (read-parser "b"     :grammar (find-grammar "ex3")) "b")
  328.  (null  (read-parser ""     :grammar (find-grammar "ex3")))
  329.  (print 3))
  330.  
  331. #+DEFSYS
  332. (progn
  333.   (compile-module "useless")
  334.   (load-module "useless")
  335.   (setq zebu:*current-grammar* (zb:find-grammar "useless"))
  336.   )
  337.  
  338. #+DEFSYS
  339. (progn (compile-module "lr4-21") (load-module "lr4-21"))
  340.  
  341. #-DEFSYS
  342. (progn
  343.   (zebu-compile-file (merge-pathnames
  344.                       (make-pathname :name "lr4-21" :type "zb") *ZEBU-test-directory*)
  345.                      :output-file
  346.                      (merge-pathnames
  347.                       (make-pathname :name "lr4-21" :type "tab")
  348.                       *ZEBU-test-binary-directory*))
  349.   
  350.   (zb:zebu-load-file (merge-pathnames
  351.                       (make-pathname :name "lr4-21" :type "tab")
  352.                       *ZEBU-test-binary-directory*)))
  353.  
  354. (setq zebu:*current-grammar* (zb:find-grammar "lr4-21"))
  355. (read-parser "foo = 0")
  356. (read-parser "foo = x")
  357.  
  358. (read-parser "*foo = x")
  359. (read-parser "*0 = x")
  360. (read-parser "**foo = ***x")
  361.  
  362.  
  363. (zb:zebu-load-file
  364.  (compile-slr-grammar (merge-pathnames "ex4.40.zb" *ZEBU-TEST-DIRECTORY*)
  365.               :output-file (merge-pathnames
  366.                     "ex4.40.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  367. ; this should print warnings
  368. ;    The following non-terminals where defined but not used: D E 
  369. (equal (zb:read-parser "b" :grammar (find-grammar "ex4.40"))
  370.        "b")
  371.  
  372. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  373. ;;                           Propositional Calculus
  374. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  375. (let ((zebu:*allow-conflicts* t)
  376.       (*generate-domain* t)
  377.       (*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  378.   (compile-lalr1-grammar "pc1.zb"
  379.    :output-file (merge-pathnames "pc1.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  380.   (load "pc1-domain.lisp")
  381.   (load "pc1-printers.lisp")
  382.   (zebu-load-file (merge-pathnames "pc1.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  383.   (setq zebu:*current-grammar* (zb:find-grammar "pc1"))
  384.   )
  385.  
  386. (unless (and
  387.      (eq (type-of (read-parser "P")) 'PROPOSITIONAL-VARIABLE)
  388.      (type-of (read-parser "P and Q"))
  389.      (string= (format nil "~s" (read-parser "P and Q"))
  390.           "P and Q"))
  391.   (warn "pc1 didn't compile correctly"))
  392.  
  393. (read-parser "P and Q and R")
  394. (read-parser "P and Q or R and S")
  395. (read-parser "(P and Q) or R and S")
  396. (read-parser "P and (Q or R) and S")
  397. (string= (format nil "~s" (read-parser "P(a: 1 b:S)"))
  398.      "P(A: 1 B: S)")
  399. (let ((zb:*preserve-case* t))
  400.   (unless (string= (format nil "~s" (read-parser "P(a: 1 b:S)"))
  401.            "P(a: 1 b: S)")
  402.     (warn "Printing with grammar pc1 failed")))
  403.  
  404. (let ((zb:*preserve-case* nil))
  405.   (unless (string= (format nil "~s" (read-parser "walks(agent: John)"))
  406.            "WALKS(AGENT: JOHN)")
  407.     (warn "Printing with grammar pc1 failed")))
  408.  
  409. (zebu::print-actions "pc1")
  410. (zebu::print-productions)
  411. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  412. ;;                                dangling else
  413. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  414. (let ((zebu:*allow-conflicts* t) (zebu:*warn-conflicts* t))
  415.   (zebu-load-file
  416.    (compile-lalr1-grammar 
  417.     (merge-pathnames "dangelse.zb" *ZEBU-TEST-DIRECTORY*)
  418.     :output-file (merge-pathnames "dangelse.tab"
  419.                   *ZEBU-TEST-BINARY-DIRECTORY*))))
  420.  
  421. (unless (equal (read-parser "if f then if g then h else i" 
  422.                 :grammar (find-grammar "dangelse"))
  423.            '("if" F "then" ("if" G "then" H "else" I)))
  424.   (warn "error in dangelse grammar"))
  425.  
  426. #+DEFSYS
  427. (progn (compile-module "pc2") (load-module "pc2")
  428.        )
  429.  
  430. #-DEFSYS
  431. (progn (zebu-load-file
  432.         (compile-lalr1-grammar 
  433.          (merge-pathnames "pc2.zb" *ZEBU-TEST-DIRECTORY*)
  434.          :output-file (merge-pathnames "pc2.tab"
  435.                                        *ZEBU-TEST-BINARY-DIRECTORY*))))
  436.  
  437. (def-tree-attributes Atomic-Wff
  438.     Atomic-Wff--predicate
  439.   )
  440.  
  441. (def-tree-attributes Role-Argument-Pair
  442.     Role-Argument-Pair--Role
  443.     Role-Argument-Pair--Argument)
  444.  
  445. (def-tree-attributes Boolean-And
  446.     Boolean-Expr--rand1
  447.     Boolean-Expr--rand2)
  448.  
  449. (zebu-load-file
  450.  (merge-pathnames "pc1.tab"
  451.           *ZEBU-TEST-BINARY-DIRECTORY*))
  452.  
  453.  
  454. (or (kb-equal (zb:read-parser "walks(agent: John)" 
  455.                   :grammar (zb:find-grammar "pc1"))
  456.         (zb:read-parser "walks(agent: John)" 
  457.                 :grammar (zb:find-grammar "pc2")))
  458.     (warn "error in grammar pc2: 1"))
  459.  
  460. (def-tree-attributes Atomic-Wff
  461.     Atomic-Wff--Role-Argument-Pairs
  462.   )
  463.  
  464. (and (kb-equal (zb:read-parser "walks(agent: John)" :grammar (zb:find-grammar "pc1"))
  465.            (zb:read-parser "walks(agent: Joe)" :grammar (zb:find-grammar "pc2")))
  466.      (warn "error in grammar pc2: 2"))
  467.  
  468. (or (kb-equal (zb:read-parser "walks(agent: John) and talks(agent: John)"
  469.                 :grammar (zb:find-grammar "pc1"))
  470.         (zb:read-parser "walks(agent: John) and talks(agent: John)"
  471.                 :grammar (zb:find-grammar "pc2")))
  472.     (warn "error in grammar pc2: 3"))
  473.  
  474. (unless (typep (zb:read-parser "walks(agent: John) and talks(agent: John) and Q"
  475.                    :grammar (zb:find-grammar "pc2"))
  476.            'BOOLEAN-AND)
  477.   (warn "error in grammar pc2: 4"))
  478.  
  479. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  480. ;;                            recompile NLL grammar
  481. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  482. #+(and DEFSYS (not MCL))
  483. (let ((nll-sys (probe-file (merge-pathnames
  484.                             "NLL-sys.l"
  485.                             (make-pathname :directory
  486.                                            (append (butlast (pathname-directory
  487.                                                              *ZEBU-directory*))
  488.                                                    (list "nll")))))))
  489.   (when nll-sys
  490.     (load nll-sys)
  491.     (let (zebu:*warn-conflicts* (zebu:*allow-conflicts* t))
  492.       (compile-module "nll-grammar"))
  493.     (load-system 'NLL-test) )
  494.   
  495.   (load-module "test-nll-syntax-1")
  496.   (load-module "test-nll-syntax-2")
  497.   (load-module "nll-simplify-test-1")
  498.   (load-module "nll-simplify-test-2")
  499.   (load-module "drt-to-lgq-test"))
  500.  
  501. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  502. ;;                                 avm grammar
  503. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  504. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  505.   (zb:zebu-compile-file "avm.zb"
  506.             :output-file (merge-pathnames
  507.                       "avm.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  508.   
  509.   (load "avm-printers.lisp"))
  510. (let ((*default-pathname-defaults* *ZEBU-TEST-BINARY-DIRECTORY*))
  511.   (zb:zebu-load-file "avm.tab"))
  512.  
  513. (unless (and
  514.      (equalp (zb:read-parser "[(s1 v1) (s2 v2)]" :grammar (find-grammar "avm"))
  515.          '#S(FEAT-TERM
  516.              -TYPE NIL
  517.              -SLOTS (#S(LABEL-VALUE-PAIR -LABEL S1 -VALUE V1)
  518.                    #S(LABEL-VALUE-PAIR -LABEL S2 -VALUE V2))))
  519.      (equalp (zb:read-parser "[(s1 v1) (s2 %1= v2) (s3 %1)]"
  520.                  :grammar (find-grammar "avm"))
  521.          '#S(FEAT-TERM
  522.              -TYPE NIL
  523.              -SLOTS (#S(LABEL-VALUE-PAIR -LABEL S1 -VALUE V1)
  524.                    #S(LABEL-VALUE-PAIR
  525.                   -LABEL S2
  526.                   -VALUE #S(TAGGED-TERM
  527.                         -TERM V2
  528.                         -TAG #S(GENERAL-VAR -NAME 1)))
  529.                    #S(LABEL-VALUE-PAIR
  530.                   -LABEL S3
  531.                   -VALUE #S(GENERAL-VAR -NAME 1)))))
  532.      (equalp (zb:read-parser "type: foo [(s1 v1) (s2 %1= v2) (s3 %1)]"
  533.                  :grammar (find-grammar "avm"))
  534.          '#S(FEAT-TERM -TYPE FOO
  535.              -SLOTS (#S(LABEL-VALUE-PAIR -LABEL S1 -VALUE V1)
  536.                      #S(LABEL-VALUE-PAIR -LABEL S2
  537.                         -VALUE #S(TAGGED-TERM -TERM V2
  538.                                   -TAG #S(GENERAL-VAR -NAME 1)))
  539.                      #S(LABEL-VALUE-PAIR -LABEL S3
  540.                         -VALUE #S(GENERAL-VAR -NAME 1)))))
  541.      (equalp (zb:read-parser "%0 = type: foo [(s1 %0) (s2 %1= v2) (s3 %1)]"
  542.                  :grammar (find-grammar "avm"))
  543.          '#S(TAGGED-TERM
  544.              -TERM #S(FEAT-TERM
  545.                   -TYPE FOO
  546.                   -SLOTS (#S(LABEL-VALUE-PAIR
  547.                      -LABEL S1
  548.                      -VALUE #S(GENERAL-VAR -NAME 0))
  549.                     #S(LABEL-VALUE-PAIR
  550.                        -LABEL S2
  551.                        -VALUE #S(TAGGED-TERM
  552.                              -TERM V2
  553.                              -TAG #S(GENERAL-VAR -NAME 1)))
  554.                     #S(LABEL-VALUE-PAIR
  555.                        -LABEL S3
  556.                        -VALUE #S(GENERAL-VAR -NAME 1))))
  557.              -TAG #S(GENERAL-VAR -NAME 0))))
  558.   (warn "avm grammar did not compile correctly"))
  559.  
  560.  
  561. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  562.       (*load-verbose* t))
  563.   (zb:zebu-compile-file "avm1.zb"
  564.             :output-file (merge-pathnames
  565.                       "avm1.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  566. ;;(zebu::print-actions "avm1")
  567. (let ((*default-pathname-defaults* *ZEBU-TEST-BINARY-DIRECTORY*))
  568.   (zb:zebu-load-file "avm1.tab"))
  569. (zb:read-parser "[(s1 v1) (s2 v2)]" :grammar (find-grammar "avm1"))
  570. (zb:read-parser "foo: [(s1 v1) (s2 %1= v2) (s3 %1)]"
  571.         :grammar (find-grammar "avm1"))
  572. (zb:read-parser "foo: [(s1 v1) (s2 %1= v2) (s3 %1)]"
  573.         :grammar (find-grammar "avm1"))
  574. (zb:read-parser "foo: []"
  575.         :grammar (find-grammar "avm1"))
  576. (zb:read-parser " []"
  577.         :grammar (find-grammar "avm1"))
  578. (zb:read-parser " [( s1 \"foo\" )]"
  579.         :grammar (find-grammar "avm1"))
  580. (zb:read-parser " [( s1 \"foo\\\"bar\" )]"
  581.         :grammar (find-grammar "avm1"))
  582. (zb:read-parser "foo : [(s1 [(s1 v1)]) (s2 %1= v2) (s3 %1)]"
  583.         :grammar (find-grammar "avm1"))
  584.  
  585. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  586.   (zb:file-parser "sample-avm1" :grammar (find-grammar "avm1")))
  587.  
  588. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  589. ;;                         Regular Expression Compiler
  590. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  591. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  592.       (*load-verbose* t))
  593.   (load "regex-test"))
  594.  
  595. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  596.       (*load-verbose* t))
  597.   (zb:zebu-compile-file "pb.zb"
  598.             :output-file (merge-pathnames
  599.                       "pb.tab"
  600.                       *ZEBU-TEST-BINARY-DIRECTORY*)))
  601.  
  602. (let ((*default-pathname-defaults* *ZEBU-TEST-BINARY-DIRECTORY*))
  603.   (zb:zebu-load-file "pb.tab"))
  604.  
  605. (unless (equal (zb:read-parser "FOO : bar."
  606.                    :grammar (find-grammar "pb"))
  607.            '("FOO" BAR))
  608.   (warn "Didn't parse pb grammar expression."))
  609.  
  610. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  611. ;;                                   BibTeX
  612. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  613. #+HP300
  614. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  615.       (*load-verbose* t))
  616.   (zb:zebu-compile-file "bibtex.zb"
  617.             :output-file (merge-pathnames
  618.                       "bibtex.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  619.  
  620. #+HP300
  621. (let ((*default-pathname-defaults* *ZEBU-TEST-BINARY-DIRECTORY*))
  622.   (zb:zebu-load-file "bibtex.tab"))
  623.  
  624. #+HP300
  625. (read-parser "@TechReport{allen81a,
  626. key\"allen81a\",
  627. author \"ALLEN, J.F.\",
  628. title \"Maintaining Knowledge About Temporal Intervals, TR 86\",
  629. institution \"University of Rochester, Department of Computer Science\",
  630. year \"1981\"}" :grammar (find-grammar "bibtex"))
  631. #+HP300
  632. (progn
  633.   (file-parser "~/notes/lit/bib/time.bib" :grammar (find-grammar "bibtex")
  634.                :print-parse-errors t :verbose nil)
  635.   
  636.   (file-parser "~/notes/lit/bib/functional-lang.bib" :grammar (find-grammar "bibtex")
  637.                :print-parse-errors t :verbose nil)
  638.   
  639.   
  640.   (file-parser "~/notes/lit/bib/cs.bib" :grammar (find-grammar "bibtex")
  641.                :print-parse-errors t :verbose nil)
  642.   
  643.   (file-parser "~/notes/lit/bib/planning.bib" :grammar (find-grammar "bibtex")
  644.                :print-parse-errors t :verbose nil))
  645. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  646. ;;                              zebra-grammar.zb
  647. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  648. #+HP300
  649. (defvar *ZEBRA-DIRECTORY* 
  650.   (let ((d (pathname-directory *ZEBU-TEST-DIRECTORY*)))
  651.     (make-pathname :directory (append (subseq d 0 (- (length d) 2))
  652.                       (list "zebra" "zebra-release")))))
  653. #+HP700 
  654. (defvar *ZEBRA-DIRECTORY* 
  655.   (let ((d (pathname-directory *ZEBU-TEST-DIRECTORY*)))
  656.     (make-pathname :directory (list "zebra" "zebra-release"))))
  657.  
  658.  
  659.  
  660. #+(OR :HP300 :HP700)
  661. (when (and (boundp '*ZEBRA-DIRECTORY*) (probe-file *ZEBRA-DIRECTORY*))
  662.   (let ((*default-pathname-defaults* *ZEBRA-DIRECTORY*)
  663.         (*load-verbose* t))
  664.     (load "ZEBRA-system"))
  665.   )
  666.  
  667. #+(OR :HP300 :HP700)
  668. (progn
  669. (compile-system "ZEBRA")
  670. (load-system "ZEBRA")
  671.  
  672. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  673.       (*load-verbose* t))
  674.   (zb:zebu-compile-file "zebra-grammar.zb"
  675.             :output-file (merge-pathnames
  676.                       "zebra-grammar.tab"
  677.                       *ZEBU-TEST-BINARY-DIRECTORY*)))
  678.  
  679. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*)
  680.       (*load-verbose* t))
  681.   (zb:zebu-load-file (merge-pathnames "zebra-grammar.tab"
  682.                       *ZEBU-TEST-BINARY-DIRECTORY*)))
  683.  
  684. (zb:read-parser "Rule string2terminal :=
  685.                         #1 stringp(#1) --> terminal:[(-string #1)];"
  686.         :grammar (zb:find-grammar "zebra-grammar"))
  687.  
  688. (defun zebra-read-string (s)
  689.   (zb:read-parser s :grammar (zb:find-grammar "zebra-grammar")))
  690.   
  691. (zebra-read-string "Rule string2terminal :=
  692.                         #1 stringp(#1) --> terminal:[(-string #1)];")
  693. (zebra-read-string "Rule R1 := bar:[(-slot {...})] --> baz:[(-slot {a,b})]; ")
  694. (zebra-read-string "rule t1 := a:[] --> test:[];")
  695. (zebra-read-string "rule t1 := a --> test:[];")
  696. (zebra-read-string "rule t1 := a --> [test];")
  697. (zebra-read-string "rule t1 := a --> b;")
  698.  
  699. (setq zebu:*current-grammar* (zb:find-grammar "zebra-grammar"))
  700. ;;(zebu::print-collection nil)
  701. (zebu::print-productions)
  702.  
  703. (let ((zb:*preserve-case* t))
  704.   (zebra-read-string "Rule t1:=a --> test;"))
  705.  
  706. (let ((zb:*preserve-case* t)
  707.       (s " Rule t1:=a --> test;"))
  708.   (string= s (format nil "~a" (zebra-read-string s))))
  709.  
  710. ;;(zb:file-parser (merge-pathnames "zebra-parser.za" *ZEBU-TEST-DIRECTORY*))
  711. )
  712. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  713. ;;                                    time
  714. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  715. #+(and LUCID HP300)
  716. (let ((*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  717.   (zb:zebu-load-file
  718.    (zb:zebu-compile-file "time.zb"
  719.              :output-file (merge-pathnames
  720.                        "time.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  721.   
  722.   )
  723. #+(and LUCID HP300)
  724. (progn
  725.   (zebu::print-actions "time")
  726.   (zebu::print-productions))
  727. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  728. ;;                                   Kleene+
  729. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  730. (let ((zebu:*allow-conflicts* t)
  731.       (*generate-domain* t)
  732.       (*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  733.   (compile-slr-grammar "ex5.zb"
  734.    :output-file (merge-pathnames "ex5.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  735.   )
  736. (setq zebu:*current-grammar*
  737.       (zebu-load-file (merge-pathnames "ex5.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  738.  
  739. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  740. ;;                               circular print
  741. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  742. (let ((zebu:*allow-conflicts* t)
  743.       (*generate-domain* t)
  744.       (*default-pathname-defaults* *ZEBU-TEST-DIRECTORY*))
  745.   (compile-slr-grammar "ex7.zb"
  746.    :output-file (merge-pathnames "ex7.tab" *ZEBU-TEST-BINARY-DIRECTORY*))
  747.   )
  748. (setq zebu:*current-grammar*
  749.       (zebu-load-file (merge-pathnames "ex7.tab" *ZEBU-TEST-BINARY-DIRECTORY*)))
  750. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  751. ;;                  Monitoring the Zebu compiler (in Lucid CL)
  752. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  753.  
  754. ;; in fresh CL:
  755. #||
  756. (set-working-directory *ZEBU-directory*)
  757. (load "ZEBU-sys.lisp")
  758. (compile-system 'Zebu-compiler)
  759. (with-monitored-definitions (load-system 'Zebu-compiler))
  760. (set-working-directory "../nll/")
  761. (load "NLL-sys.lisp")
  762. (start-monitoring)
  763. (time (compile-module "nll-grammar"))
  764. (summarize-monitors :number-of-calls t)
  765.  
  766. (start-monitoring)
  767. (time (compile-module "ex1"))
  768. (SUMMARIZE-MONITORS)
  769.  
  770. (reset-monitors)
  771. ||#
  772.  
  773. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  774. ;;                            End of exercise.lisp
  775. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  776.